home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0693 / FINDSUBR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-30  |  3KB  |  99 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 404 of 591
  3. From : David Drzyzga                       1:3612/220.0         23 Jun 93  16:57
  4. To   : Dale Barnes                         1:3601/200.0
  5. Subj : Program wanted
  6. ────────────────────────────────────────────────────────────────────────────────
  7.  DB> Does anyone know of any program that will scan an
  8.  DB> entire programs pascal source code and give a listing
  9.  DB> of each procedure/function in each file?
  10.  
  11. Here's something I just threw together. There is minimal error checking and if
  12. you run it on a unit you will get double listings (from the interface and
  13. implementation sections).}
  14.  
  15. {------------------------------------------------------------------------------
  16.      Original source code by David Drzyzga, FidoNet 1:3612/220, SysOp of
  17.                   =>> CUTTER JOHN'S <<= (904) 932-1849 [HST]
  18.                                   06-23-1993
  19. ------------------------------------------------------------------------------}
  20. program findsubr;
  21.  
  22. uses
  23.   crt;
  24.  
  25. var
  26.   FileIn, FileOut         : text;
  27.   InFileName, OutFileName : string[79];
  28.   LineIn, Lineout         : string;
  29.  
  30. function upcasestr(s:string):string;
  31. var
  32.   st : string;
  33.   ix : byte;
  34. begin
  35.   st := '';
  36.   for ix := 1 to length(s) do st := st + upcase(s[ix]);
  37.   upcasestr := st;
  38. end; {UpCaseStr}
  39.  
  40. procedure ProcessFile;
  41. var
  42.   c:char;
  43. begin
  44.   assign(FileIn, ParamStr(1));
  45.   {$I-} Reset(FileIn); {$I+};
  46.   if IOResult <> 0 then begin
  47.     writeln(#13#10'Input file ''',ParamStr(1),''' not found.'#13#10);
  48.     halt;
  49.   end;
  50.   InFileName := ParamStr(1);
  51.   Delete(InFileName, pos('.',InFileName),4);
  52.   if Length(ParamStr(2)) > 0 then
  53.     OutFileName := ParamStr(2)
  54.   else
  55.     OutFileName := InFileName+'.$$$';
  56.   assign(FileOut, OutFileName);
  57.   {$I-} Reset(FileOut); {$I+};
  58.   if IOResult = 0 then begin
  59.     writeln;
  60.     write('Output file ''',OutFileName,''' already exists, overwrite? ');
  61.     repeat c := UpCase(ReadKey) until (c in ['Y','N']);
  62.     writeln(c,#13#10);
  63.     if c = 'N' then halt;
  64.   end;
  65.   rewrite(FileOut);
  66.   while not eof(FileIn) do begin
  67.     readln(FileIn,LineIn);
  68.     while pos(' ', LineIn) = 1 do delete(LineIn, 1 ,1);
  69.     LineOut := upcasestr(LineIn);
  70.     if (pos('PROCEDURE', LineOut) = 1) or
  71.        (pos('FUNCTION', LineOut) = 1) then
  72.       writeln(FileOut,LineIn);
  73.   end;
  74.   Close(FileIn);
  75.   Close(FileOut);
  76.   if OutFileName = InFileName + '.$$$' then begin
  77.     erase(FileIn);
  78.     rename(FileOut, ParamStr(1));
  79.   end;
  80. end; {ProcessFile}
  81.  
  82. procedure ParseCommandLine;
  83. begin
  84.   if ParamCount < 1 then begin
  85.     writeln;
  86.     writeln('Usage:  FINDSUBR <input file> <output file>');
  87.     writeln;
  88.     write('If no output file is specified the input file will be ');   
  89. writeln('overwritten.'); {on its own line just cuz wordwrap}
  90.     writeln;
  91.     halt;
  92.   end;
  93. end; {ParseCommandLine}
  94.  
  95. {Main program code}
  96. begin
  97.   ParseCommandLine;
  98.   ProcessFile;
  99. end.